Unit BFormMainUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    ExtCtrls, StdCtrls, Buttons, Menus, Spin, ActnList, HTTPDefs, strutils, fgl,
    BLogServerUnit{$ifdef unix}, process{$endif};

Const
  lkIgnore = 1;
  lkTarget = 2;

Type

{ BMethodTimerClass }

 BMethodTimerClass = Class
  Private
    bMethodName: String;
    bMethodTime: TDateTime;
  Public
    Property MethodName: String Read bMethodName;
    Property MethodTime: TDateTime Read bMethodTime;
    Constructor Build(Const aMethodName: String);
    Destructor Burn;
End;

Type BMethodTimersList = Specialize TFPGList<BMethodTimerClass>;

Type

  { TFormMain }

  TFormMain = Class(TForm)
    ActionTarget: TAction;
    ActionClearOnInit: TAction;
    ActionClear: TAction;
    ActionExpand: TAction;
    ActionListen: TAction;
    ActionIgnore: TAction;
    ActionList1: TActionList;
    ImageList1: TImageList;
    ImageList2: TImageList;
    ListBox1: TListBox;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    Panel1: TPanel;
    PopupMenu1: TPopupMenu;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Splitter1: TSplitter;
    TreeView1: TTreeView;
    Procedure ActionClearExecute(Sender: TObject);
    Procedure ActionClearOnInitExecute(Sender: TObject);
    Procedure ActionExpandExecute(Sender: TObject);
    Procedure ActionIgnoreExecute(Sender: TObject);
    Procedure ActionListenExecute(Sender: TObject);
    Procedure ActionTargetExecute(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var CloseAction: TCloseAction);
    Procedure ListBox1DblClick(Sender: TObject);
    Procedure PopupMenu1Popup(Sender: TObject);
    //Procedure SpeedButton1Click(Sender: TObject);
    //Procedure SpeedButton2Click(Sender: TObject);
    //Procedure SpeedButton3Click(Sender: TObject);
    //Procedure SpeedButton4Click(Sender: TObject);
    Procedure TreeView1SelectionChanged(Sender: TObject);
  Private
    { private declarations }
    bClearOnInit: Boolean;
    bListen: Boolean;
    bNode: TTreeNode;
    bMethodsTimers: BMethodTimersList;
    bIgnored, bTarget: TStringList;

    Function CheckInList(Const aLine: String; Const aKind: Integer;
      Const aIsMethodLine: Boolean): Boolean;

    Procedure EchoTarget(Const aTarget: String);

    Procedure OnEntry;
    Procedure OnError;
    Procedure ChangeClearOnInit;
    Procedure ChangeListen;
    Procedure StartThread;
    Procedure StopThread;
    Procedure SwitchIgnoreState(Const aText: String);
    Procedure SwitchTargetState(Const aText: String);
  Public
    { public declarations }
  End;

Var
  FormMain: TFormMain;

Implementation

{$R *.lfm}

Function CutColon(Var aSource: String): String;
Var
  aIndex: Integer;
Begin
  aIndex := Pos(':', aSource);
  If aIndex = 0 Then Exit;
  Result := Copy(aSource, 1, aIndex - 1);
  Delete(aSource, 1, aIndex);
End;

Constructor BMethodTimerClass.Build(Const aMethodName: String);
Begin
  bMethodName := aMethodName;
  bMethodTime := Now;
End;

Destructor BMethodTimerClass.Burn;
Begin

End;

{ TFormMain }

Procedure TFormMain.PopupMenu1Popup(Sender: TObject);
Var
  aText: String = '';
Begin
  //TODO: add check for methods
  If Not(TreeView1.Selected = nil) THen
    Begin
      aText := TreeView1.Selected.Text;
      If TreeView1.Selected.StateIndex = 6 Then
        aText := Trim(Copy(aText, 1, Pos('-', aText) - 2));
      ActionIgnore.Checked := Not(bIgnored.IndexOf(aText) = -1);
      ActionTarget.Checked := Not(bTarget.IndexOf(aText) = -1);
    End;
end;

Procedure TFormMain.TreeView1SelectionChanged(Sender: TObject);
Begin
  If Not(TreeView1.Selected = nil) And Not(TreeView1.Selected.Data = nil) Then
    ListBox1.Items.Text := TStringList(TreeView1.Selected.Data).Text
  Else
    ListBox1.Clear;
end;

Function TFormMain.CheckInList(Const aLine: String; Const aKind: Integer;
  Const aIsMethodLine: Boolean): Boolean;
Var
  aTarget: String;
  aLines: TStringList = nil;
Begin
  Result := FALSE;
  Case aKind Of
    lkIgnore: aLines := bIgnored;
    lkTarget: aLines := bTarget;
  End;
  If aLines = nil Then Exit;
  aTarget := Trim(aLine);
  If aIsMethodLine Then
    aTarget := Trim(Copy(aTarget, 1, Pos('-', aTarget) - 1));
  Result := Not(aLines.IndexOf(aTarget) = -1);
End;

Procedure TFormMain.EchoTarget(Const aTarget: String);
Const
  NOTIFY_MASK = '%s lazarus "%s spotted"';
Var
  aNotifySend: String = '';
Begin
  {$ifdef unix}
  With TProcess.Create(nil) Do
    Begin
      CommandLine := 'which notify-send';
      Options := Options + [poWaitOnExit, poUsePipes];
      Execute;
      With TStringList.Create Do
        Begin
          LoadFromStream(Output);
          aNotifySend := Text;
          WriteLn(Text);
          WriteLn('Send: ', Trim(aNotifySend));
          If Pos('which: no notify-send', aNotifySend) = 0 Then
            Begin
              Clear;
              CommandLine := Format(NOTIFY_MASK, [aNotifySend, aTarget]);
              WriteLn(CommandLine);
              Execute;
            End;
          Free;
        End;
      Free;
    End;
  {$endif}
End;

Procedure TFormMain.OnEntry;
Var
  aEntry: String;
  aMessage: String;
  aValue: String;
  aNode: TTreeNode;
  aType: Integer;
  i: Integer;
  aEmpty: Boolean;
  aNodeText: String;
  Procedure EnsureVisible(Const aNode: TTreeNode);
  Var
    aParentNode: TTreeNode;
  Begin
    aParentNode := aNode.Parent;
    While Not(aParentNode = nil) Do
      Begin
        aParentNode.Expand(FALSE);
        aParentNode := aParentNode.Parent;
      End;
  End;

Begin
  aEntry := ServerThread.Entry;
  aMessage := CutColon(aEntry);
  aType := StrToInt(CutColon(aEntry));
  aValue := aEntry;
  Case aMessage Of
    '*INIT*':
      Begin
        If bClearOnInit Then TreeView1.Items.Clear;
        bNode := TreeView1.Items.Add(nil, 'Init');
        bNode.StateIndex := aType;
      End;
    '*ENTER*':
      Begin
        bNode := TreeView1.Items.AddChild(bNode, aValue);
        bNode.StateIndex := aType;
        bMethodsTimers.Add(BMethodTimerClass.Build(aValue));
      End;
    '*LEAVE*':
      Begin
        //TODO: add error info - skip one level
        While Not((bNode = nil) Or (bNode.Text = aValue)) Do
          bNode := bNode.Parent;
        If (bNode = nil) Then bNode := TreeView1.Items.GetFirstNode;
        If Not(bTarget.IndexOf(bNode.Text) = -1) Then
          Begin
            EnsureVisible(bNode);
            bNode.Expand(True);
            EchoTarget(bNode.Text);
          End;
        For i := bMethodsTimers.Count - 1 DownTo 0 Do
          Begin
            If bMethodsTimers[i].MethodName = aValue Then
              Begin
                bNode.Text := bNode.Text + ' - ' +
                  FormatDateTime('ss:zz', Now - bMethodsTimers[i].MethodTime);
                bMethodsTimers[i].Burn;
                bMethodsTimers.Delete(i);
                Break;
              End;
            bMethodsTimers[i].Burn;
            bMethodsTimers.Delete(i);
          End;
        bNode := bNode.Parent;
      End;
    '*FIN*':
      If Not(TreeView1.Items.GetFirstNode = nil) Then
        TreeView1.Items.GetFirstNode.Expand(FALSE);
    Else
      Begin
        aEmpty := aMessage = '';
        Case aType Of
          0: aNodeText := IfThen(aEmpty, 'Text', aMessage) + ' - ' + aValue;
          1: aNodeText := IfThen(aEmpty, 'Int', aMessage) + ' - ' + aValue;
          2: aNodeText := IfThen(aEmpty, 'Date', aMessage) + ' - ' + aValue;
          3: aNodeText := IfThen(aEmpty, 'Obj', aMessage) + ' - ' + aValue;
          4: aNodeText := IfThen(aEmpty, 'List', aMessage);
          5: aNodeText := IfThen(aEmpty, 'Stack', aMessage);
          6: aNodeText := IfThen(aEmpty, 'Method', aMessage); // impossibru
          7: aNodeText := IfThen(aEmpty, 'Exception', aMessage) + ' - ' +
            CutColon(aValue);
        End;
        aNode := TreeView1.Items.AddChild(bNode, aNodeText);
        aNode.StateIndex := aType;
        aNode.Data := TStringList.Create;
        If Not(bTarget.IndexOf(aNode.Text) = -1) Then
          Begin
            EnsureVisible(aNode);
            EchoTarget(aNode.Text);
          End;
        TStringList(aNode.Data).Text := aValue;
      End;
  End;
End;

Procedure TFormMain.OnError;
Begin
  ServerThread.Terminate;
  ServerThread := nil;
  SpeedButton1.Down := FALSE;
  ChangeClearOnInit;
End;

Procedure TFormMain.ChangeClearOnInit;
Begin
  If ServerThread = nil Then
    Begin
      bClearOnInit := TRUE;
      ActionClearOnInit.Checked := TRUE;
      Exit;
    End;
  bClearOnInit := Not(bClearOnInit);
  ActionClearOnInit.Checked := bClearOnInit;
End;

Procedure TFormMain.ChangeListen;
Begin
  bListen := Not(bListen);
  If bListen Then StartThread
  Else StopThread;
End;

Procedure TFormMain.StartThread;
Begin
  ServerThread := TServerThread.Build;
  ServerThread.OnEntry := @OnEntry;
  ServerThread.OnError := @OnError;
  bListen := FALSE;
  ActionListen.Checked := TRUE;
End;

Procedure TFormMain.StopThread;
Begin
  Try
    ServerThread.StopServer;
    ServerThread.Terminate;
  Except On E: Exception Do
    //WriteLn(E.Message);// Exception Hate
  End;
  ServerThread := nil;
  ChangeClearOnInit;
  ActionListen.Checked := FALSE;
End;

Procedure TFormMain.SwitchIgnoreState(Const aText: String);
Var
  aIndex: Integer;
Begin
  aIndex := bIgnored.IndexOf(aText);
  If aIndex = -1 Then
    bIgnored.Add(aText)
  Else
    bIgnored.Delete(aIndex);
End;

Procedure TFormMain.SwitchTargetState(Const aText: String);
Var
  aIndex: Integer;
Begin
  aIndex := bTarget.IndexOf(aText);
  If aIndex = -1 Then
    bTarget.Add(aText)
  Else
    bTarget.Delete(aIndex);
End;

Procedure TFormMain.FormCreate(Sender: TObject);
Begin
  bListen := FALSE;
  bClearOnInit := TRUE;
  bMethodsTimers := BMethodTimersList.Create;
  bIgnored := TStringList.Create;
  bTarget := TStringList.Create;
End;

Procedure TFormMain.FormClose(Sender: TObject; Var CloseAction: TCloseAction);
Begin
  If Not(ServerThread = nil) Then StopThread;
  bMethodsTimers.Free;
  bIgnored.Free;
  bTarget.Free;
End;

Procedure TFormMain.ListBox1DblClick(Sender: TObject);
  Function CutSpace(Var aSource: String): String;
  Var
    aIndex: Integer;
  Begin
    aIndex := Pos(#32, aSource);
    If aIndex = 0 Then Exit;
    Result := Copy(aSource, 1, aIndex - 1);
    Delete(aSource, 1, aIndex);
  End;
Var
  aLine: String;
  aIndex: Integer;
  aUnitName: String;
Begin
  If Not(ListBox1.ItemIndex = -1) Then
    Begin
      aLine := Trim(ListBox1.Items[ListBox1.ItemIndex]);
      If (Pos('line', aLine) > 0) And (Pos('of', aLine) > 0) Then
        Begin
          CutSpace(aLine);
          CutSpace(aLine);
          aIndex := StrToIntDef(CutSpace(aLine), -1);
          If aIndex = -1 Then Exit;
          CutSpace(aLine);
          aUnitName := aLine;
          WriteLn(aIndex, #32, aUnitName);
        End
    End;
end;

Procedure TFormMain.ActionListenExecute(Sender: TObject);
Begin
  ChangeListen;
end;

Procedure TFormMain.ActionClearOnInitExecute(Sender: TObject);
Begin
  ChangeClearOnInit;
end;

Procedure TFormMain.ActionExpandExecute(Sender: TObject);
  Procedure ExpandNode(Const aNode: TTreeNode);
  Var
    i: Integer;
  Begin
    If CheckInList(aNode.Text, lkIgnore, aNode.StateIndex = 6) Then Exit;
    aNode.Expand(FALSE);
    If Not(aNode.GetFirstChild = nil) Then
      For i := 0 To aNode.Count - 1 Do
        ExpandNode(aNode.Items[i]);
  End;
Var
  aNode: TTreeNode;
Begin
  If Not(TreeView1.Selected = nil) Then
    ExpandNode(TreeView1.Selected);
end;

Procedure TFormMain.ActionIgnoreExecute(Sender: TObject);
Var
  aNode: TTreeNode;
Begin
  aNode := TreeView1.Selected;
  If Not(aNode = nil) Then
    If aNode.StateIndex = 6 Then
      SwitchIgnoreState(Trim(Copy(aNode.Text, 1, Pos('-', aNode.Text) - 2)))
    Else
      SwitchIgnoreState(aNode.Text);
end;

Procedure TFormMain.ActionTargetExecute(Sender: TObject);
Var
  aNode: TTreeNode;
Begin
  aNode := TreeView1.Selected;
  If Not(aNode = nil) Then
    If aNode.StateIndex = 6 Then
      SwitchTargetState(Trim(Copy(aNode.Text, 1, Pos('-', aNode.Text) - 2)))
    Else
      SwitchTargetState(aNode.Text);
end;

Procedure TFormMain.ActionClearExecute(Sender: TObject);
Begin
  TreeView1.Items.Clear;
  bNode := TreeView1.Items.Add(nil, 'Init');
  bNode.StateIndex := 6;
end;

End.

